Univalle


1. Introducción

1.1 Relevancia del Análisis

[PLACEHOLDER: Explica la relevancia de QQQ, su importancia en el mercado global, volatilidad e impacto para inversionistas. Incluir contexto del Nasdaq-100 ETF.]

1.2 Metodología: Modelos ARIMA

[PLACEHOLDER: Introducción a los conceptos fundamentales de ARIMA (Autorregresivos, Integrados, Media Móvil), su importancia teórica y utilidad práctica en pronósticos de series temporales financieras.]


2. Descripción de la Serie Temporal

2.1 Contexto Histórico y Datos

[PLACEHOLDER: Contexto completo del QQQ (Nasdaq-100 ETF), período de análisis seleccionado (octubre 2022 - presente), eventos significativos que han afectado el precio (crisis de volatilidad, cambios de política monetaria, rally de IA, etc.)]

serie_QQQ <- getSymbols("QQQ", src="yahoo", auto.assign=FALSE, from="2015-01-01") 
Precio <- serie_QQQ$`QQQ.Close`

Gráfico Dinámico de la Serie

datos_qqq <- data.frame(
  Fecha = index(Precio),
  Precio = as.numeric(Precio)
)

datos_qqq <- datos_qqq %>%
  mutate(Corte = as.yearqtr(Fecha)) 

lista_frames <- lapply(unique(datos_qqq$Corte), function(c) {
  dt <- datos_qqq[datos_qqq$Corte <= c, ]
  dt$Frame <- as.character(c) 
  return(dt)
})

datos_animados <- dplyr::bind_rows(lista_frames)

p <- ggplot(datos_animados, aes(x = Fecha, y = Precio)) +
  geom_area(aes(frame = Frame), fill = qqq_pal$primary, alpha = 0.1, position = "identity") +
  geom_line(aes(frame = Frame), color = qqq_pal$primary, size = 0.8) +
  labs(
    title = "Evolución Dinámica del QQQ",
    subtitle = "Crecimiento histórico acumulado desde octubre 2022",
    x = "", 
    y = "Precio (USD)"
  ) +
  scale_y_continuous(labels = scales::dollar_format()) +
  theme_QQQ() +
  theme(plot.title = element_text(size = 14))

plotly::ggplotly(p, tooltip = c("x", "y")) %>%
  plotly::layout(
    paper_bgcolor = 'rgba(0,0,0,0)',
    plot_bgcolor = 'rgba(0,0,0,0)',
    font = list(family = "Inter, sans-serif", color = qqq_pal$text_gray),
    hovermode = "x unified"
  ) %>%
  plotly::animation_opts(frame = 100, transition = 0, redraw = FALSE) %>%
  plotly::animation_slider(currentvalue = list(prefix = "Período: ")) %>%
  plotly::config(displayModeBar = FALSE)

2.2 Estadísticas Descriptivas

[PLACEHOLDER: Estadísticas completas de la serie - Media, Mediana, Desv. Est., Rango, Cuartiles. Tablas formateadas con kableExtra.]


4. Resultados del Modelo ARIMA

4.1 Partición de Datos

4.1.1 Estrategia Train/Test

Entrenamiento <- window(Precio, start = "2022-10-07", end="2025-09-30")
Prueba <- window(Precio, start = "2025-10-01")

4.1.2 Tabla Resumen: Observaciones por Conjunto

particion_resumen <- data.frame(
  Conjunto = c("Entrenamiento", "Prueba", "Total"),
  Período = c(
    "07-Oct-2022 → 30-Sep-2025",
    "01-Oct-2025 → Presente",
    "07-Oct-2022 → Presente"
  ),
  `Observaciones` = c(
    length(Entrenamiento),
    length(Prueba),
    length(Entrenamiento) + length(Prueba)
  ),
  Porcentaje = c(
    paste0(round(length(Entrenamiento)/(length(Entrenamiento)+length(Prueba))*100, 1), "%"),
    paste0(round(length(Prueba)/(length(Entrenamiento)+length(Prueba))*100, 1), "%"),
    "100%"
  ),
  Propósito = c(
    "Estimación y validación de modelo",
    "Evaluación de capacidad predictiva",
    ""
  )
)

kable(particion_resumen,
      caption = "Resumen de Partición de Datos: Entrenamiento vs Prueba",
      align = c("l", "c", "c", "c", "l")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(1, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(3, bold = TRUE, color = qqq_pal$positive) %>%
  row_spec(3, bold = TRUE, background = "#e8f5e9", color = qqq_pal$text_dark)
Resumen de Partición de Datos: Entrenamiento vs Prueba
Conjunto Período Observaciones Porcentaje Propósito
Entrenamiento 07-Oct-2022 → 30-Sep-2025 747 94.4% Estimación y validación de modelo
Prueba 01-Oct-2025 → Presente 44 5.6% Evaluación de capacidad predictiva
Total 07-Oct-2022 → Presente 791 100%

4.1.3 Visualización: Serie con Partición

df_train <- data.frame(
  Fecha = index(Entrenamiento),
  Precio = as.numeric(Entrenamiento),
  Conjunto = "Entrenamiento"
)

df_test <- data.frame(
  Fecha = index(Prueba),
  Precio = as.numeric(Prueba),
  Conjunto = "Prueba"
)

df_completo <- bind_rows(df_train, df_test)
fecha_corte <- as.Date("2025-10-01")

ggplot(df_completo, aes(x = Fecha, y = Precio)) +
  geom_ribbon(data = df_train, 
              aes(ymin = min(df_completo$Precio) * 0.95, ymax = Precio),
              fill = qqq_pal$primary, alpha = 0.08) +
  geom_ribbon(data = df_test, 
              aes(ymin = min(df_completo$Precio) * 0.95, ymax = Precio),
              fill = qqq_pal$secondary, alpha = 0.15) +
  geom_line(data = df_train, color = qqq_pal$primary, linewidth = 0.9) +
  geom_line(data = df_test, color = qqq_pal$secondary, linewidth = 1.1) +
  geom_vline(xintercept = fecha_corte, 
             linetype = "dashed", color = qqq_pal$negative, linewidth = 0.8) +
  annotate("text", x = fecha_corte, y = max(df_completo$Precio) * 1.02,
           label = "Corte: 01-Oct-2025", hjust = -0.05, vjust = 0,
           color = qqq_pal$negative, fontface = "bold", size = 3.5) +
  annotate("label", 
           x = as.Date("2024-01-01"), 
           y = max(df_completo$Precio) * 0.85,
           label = paste0("ENTRENAMIENTO\n", nrow(df_train), " observaciones"),
           fill = qqq_pal$primary, color = "white", 
           fontface = "bold", size = 3.5, label.padding = unit(0.5, "lines")) +
  annotate("label", 
           x = max(df_test$Fecha) - 10,
           y = min(df_completo$Precio) * 1.15,
           label = paste0("PRUEBA\n", nrow(df_test), " obs."),
           fill = qqq_pal$secondary, color = "white", 
           fontface = "bold", size = 3.2, label.padding = unit(0.4, "lines")) +
  scale_x_date(date_breaks = "4 months", date_labels = "%b %Y",
               expand = expansion(mult = c(0.02, 0.05))) +
  scale_y_continuous(labels = dollar_format(prefix = "$"),
                     expand = expansion(mult = c(0.05, 0.08))) +
  labs(
    title = "Partición de Datos: Entrenamiento vs Prueba",
    subtitle = "QQQ (Nasdaq-100 ETF) | Serie de precios de cierre diarios",
    x = NULL,
    y = "Precio de Cierre (USD)",
    caption = paste0("Fuente: Yahoo Finance | Período: ", 
                     min(df_completo$Fecha), " a ", max(df_completo$Fecha))
  ) +
  theme_QQQ() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

4.2 Análisis de Estacionariedad

La metodología Box-Jenkins requiere que la serie temporal sea estacionaria. En esta sección se evalúan la estacionariedad de la serie en niveles y se aplica diferenciación si es necesario.

4.2.1 Serie en Niveles

acf_data <- acf(Entrenamiento, lag.max = 30, plot = FALSE)

df_acf <- data.frame(
  Lag = acf_data$lag[-1], 
  ACF = acf_data$acf[-1]
)

n <- length(Entrenamiento)
limite_sup <- qnorm(0.975) / sqrt(n)
limite_inf <- -limite_sup

ggplot(df_acf, aes(x = Lag, y = ACF)) +
  geom_segment(aes(xend = Lag, yend = 0), 
               color = qqq_pal$primary, linewidth = 0.8) +
  geom_point(color = qqq_pal$primary, size = 2) +
  geom_hline(yintercept = limite_sup, linetype = "dashed", 
             color = qqq_pal$secondary, linewidth = 0.7) +
  geom_hline(yintercept = limite_inf, linetype = "dashed", 
             color = qqq_pal$secondary, linewidth = 0.7) +
  geom_hline(yintercept = 0, color = qqq_pal$text_gray, linewidth = 0.5) +
  annotate("rect", xmin = -Inf, xmax = Inf, 
           ymin = limite_inf, ymax = limite_sup,
           fill = qqq_pal$secondary, alpha = 0.1) +
  annotate("label", x = 20, y = 0.5,
           label = "Decaimiento lento\n→ Serie NO estacionaria",
           fill = qqq_pal$negative, color = "white",
           fontface = "bold", size = 3.5, label.padding = unit(0.5, "lines")) +
  scale_x_continuous(breaks = seq(0, 30, 5)) +
  scale_y_continuous(limits = c(-0.1, 1.05), breaks = seq(0, 1, 0.25)) +
  labs(
    title = "Función de Autocorrelación (ACF) - Serie en Niveles",
    subtitle = "QQQ: Precio de cierre | Datos de entrenamiento",
    x = "Rezago (Lag)",
    y = "Autocorrelación",
    caption = "Bandas azules: Límites de significancia al 95%"
  ) +
  theme_QQQ()

4.2.2 Prueba: Test de Dickey-Fuller Aumentado (ADF)

adf_resultado <- adf.test(Entrenamiento)

tabla_adf <- data.frame(
  Métrica = c("Estadístico Dickey-Fuller", 
              "Orden de Rezagos (Lag)", 
              "P-valor",
              "Nivel de Significancia (α)",
              "Hipótesis Nula (H₀)",
              "Decisión"),
  Valor = c(round(adf_resultado$statistic, 4),
            adf_resultado$parameter,
            round(adf_resultado$p.value, 4),
            "0.05",
            "Serie tiene raíz unitaria",
            ifelse(adf_resultado$p.value > 0.05, 
                   "No rechazar H₀", "Rechazar H₀")),
  Interpretación = c("Valor del estadístico de prueba",
                     "Rezagos incluidos en el test",
                     "Probabilidad bajo H₀",
                     "Umbral de decisión",
                     "La serie NO es estacionaria",
                     ifelse(adf_resultado$p.value > 0.05,
                            "Serie NO estacionaria",
                            "Serie estacionaria ✓"))
)

kable(tabla_adf, 
      caption = "Prueba de Dickey-Fuller Aumentada (ADF) - Serie en Niveles",
      align = c("l", "c", "l")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  row_spec(3, bold = TRUE, color = qqq_pal$negative, background = "#ffe8e0") %>% 
  row_spec(6, bold = TRUE, background = "#fef3f2", color = qqq_pal$text_dark)
Prueba de Dickey-Fuller Aumentada (ADF) - Serie en Niveles
Métrica Valor Interpretación
Estadístico Dickey-Fuller -3.0468 Valor del estadístico de prueba
Orden de Rezagos (Lag) 9 Rezagos incluidos en el test
P-valor 0.1352 Probabilidad bajo H₀
Nivel de Significancia (α) 0.05 Umbral de decisión
Hipótesis Nula (H₀) Serie tiene raíz unitaria La serie NO es estacionaria
Decisión No rechazar H₀ Serie NO estacionaria

Conclusión: La prueba ADF indica claramente que la serie NO es estacionaria (p > 0.05). Se requiere aplicar diferenciación.

4.2.3 Aplicación de Diferenciación de Primer Orden

dif_Entrenamiento <- diff(Entrenamiento) %>% na.omit()
df_diff <- data.frame(
  Fecha = index(dif_Entrenamiento),
  Valor = as.numeric(dif_Entrenamiento)
)

ggplot(df_diff, aes(x = Fecha, y = Valor)) +
  geom_line(color = qqq_pal$secondary, linewidth = 0.6) +
  geom_hline(yintercept = 0, linetype = "dashed", 
             color = qqq_pal$primary, linewidth = 0.7) +
  annotate("label", 
           x = as.Date("2023-06-01"), 
           y = max(df_diff$Valor) * 0.85,
           label = paste0("Media ≈ ", round(mean(df_diff$Valor), 3)),
           fill = qqq_pal$primary, color = "white",
           fontface = "bold", size = 3.5, label.padding = unit(0.4, "lines")) +
  scale_x_date(date_breaks = "4 months", date_labels = "%b %Y",
               expand = expansion(mult = c(0.02, 0.03))) +
  scale_y_continuous(labels = scales::dollar_format(prefix = "$"),
                     expand = expansion(mult = c(0.05, 0.08))) +
  labs(
    title = "Serie Diferenciada de Primer Orden (d = 1)",
    subtitle = "QQQ: Cambios diarios en precio de cierre | Datos de entrenamiento",
    x = NULL,
    y = "Cambio Diario (USD)",
    caption = paste0("Observaciones: ", nrow(df_diff), 
                     " | Período: ", min(df_diff$Fecha), " a ", max(df_diff$Fecha))
  ) +
  theme_QQQ() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

4.2.3 Verificación Post-Diferenciación

acf_diff_data <- acf(dif_Entrenamiento, lag.max = 30, plot = FALSE)

df_acf_diff <- data.frame(
  Lag = acf_diff_data$lag[-1],
  ACF = acf_diff_data$acf[-1]
)

n_diff <- length(dif_Entrenamiento)
limite_sup_diff <- qnorm(0.975) / sqrt(n_diff)
limite_inf_diff <- -limite_sup_diff

ggplot(df_acf_diff, aes(x = Lag, y = ACF)) +
  geom_segment(aes(xend = Lag, yend = 0), 
               color = qqq_pal$secondary, linewidth = 0.8) +
  geom_point(color = qqq_pal$secondary, size = 2) +
  geom_hline(yintercept = limite_sup_diff, linetype = "dashed", 
             color = qqq_pal$primary, linewidth = 0.7) +
  geom_hline(yintercept = limite_inf_diff, linetype = "dashed", 
             color = qqq_pal$primary, linewidth = 0.7) +
  geom_hline(yintercept = 0, color = qqq_pal$text_gray, linewidth = 0.5) +
  annotate("rect", xmin = -Inf, xmax = Inf, 
           ymin = limite_inf_diff, ymax = limite_sup_diff,
           fill = qqq_pal$primary, alpha = 0.1) +
  annotate("label", x = 22, y = 0.12,
           label = "Autocorrelaciones dentro\nde bandas → Estacionaria ✓",
           fill = qqq_pal$positive, color = "white",
           fontface = "bold", size = 3.5, label.padding = unit(0.5, "lines")) +
  scale_x_continuous(breaks = seq(0, 30, 5)) +
  scale_y_continuous(limits = c(-0.15, 0.2), breaks = seq(-0.1, 0.2, 0.05)) +
  labs(
    title = "Función de Autocorrelación (ACF) - Serie Diferenciada",
    subtitle = "QQQ: Cambios diarios | Verificación de estacionariedad post-diferenciación",
    x = "Rezago (Lag)",
    y = "Autocorrelación",
    caption = "Bandas verdes: Límites de significancia al 95%"
  ) +
  theme_QQQ()

adf_diff_resultado <- adf.test(dif_Entrenamiento)

tabla_adf_diff <- data.frame(
  Métrica = c("Estadístico Dickey-Fuller", 
              "Orden de Rezagos (Lag)", 
              "P-valor",
              "Nivel de Significancia (α)",
              "Hipótesis Nula (H₀)",
              "Decisión"),
  Valor = c(round(adf_diff_resultado$statistic, 4),
            adf_diff_resultado$parameter,
            round(adf_diff_resultado$p.value, 4),
            "0.05",
            "Serie tiene raíz unitaria",
            ifelse(adf_diff_resultado$p.value < 0.05, 
                   "Rechazar H₀", "No rechazar H₀")),
  Interpretación = c("Valor del estadístico de prueba",
                     "Rezagos incluidos en el test",
                     "Probabilidad bajo H₀",
                     "Umbral de decisión",
                     "La serie NO es estacionaria",
                     ifelse(adf_diff_resultado$p.value < 0.05,
                            "Serie ES estacionaria ✓",
                            "Serie NO estacionaria"))
)

kable(tabla_adf_diff, 
      caption = "Prueba de Dickey-Fuller Aumentada (ADF) - Serie Diferenciada (d=1)",
      align = c("l", "c", "l")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  row_spec(3, bold = TRUE, color = qqq_pal$positive, background = "#e8f5e9") %>%
  row_spec(6, bold = TRUE, background = "#d4edda", color = qqq_pal$text_dark)
Prueba de Dickey-Fuller Aumentada (ADF) - Serie Diferenciada (d=1)
Métrica Valor Interpretación
Estadístico Dickey-Fuller -8.6831 Valor del estadístico de prueba
Orden de Rezagos (Lag) 9 Rezagos incluidos en el test
P-valor 0.01 Probabilidad bajo H₀
Nivel de Significancia (α) 0.05 Umbral de decisión
Hipótesis Nula (H₀) Serie tiene raíz unitaria La serie NO es estacionaria
Decisión Rechazar H₀ Serie ES estacionaria ✓

Conclusión: Con p-valor < 0.05, se rechaza H₀. La serie diferenciada ES estacionaria. Por tanto, el orden de integración es d = 1.


4.3 Identificación del Modelo

4.3.1 Análisis ACF/PACF - Serie Diferenciada

acf_data <- acf(dif_Entrenamiento, lag.max = 28, plot = FALSE)
pacf_data <- pacf(dif_Entrenamiento, lag.max = 28, plot = FALSE)

df_acf <- data.frame(
  Lag = as.numeric(acf_data$lag[-1]),
  Valor = as.numeric(acf_data$acf[-1])
)

df_pacf <- data.frame(
  Lag = as.numeric(pacf_data$lag),
  Valor = as.numeric(pacf_data$acf)
)

n <- length(dif_Entrenamiento)
limite <- qnorm(0.975) / sqrt(n)

p_acf <- ggplot(df_acf, aes(x = Lag, y = Valor)) +
  geom_hline(yintercept = 0, color = qqq_pal$text_gray, linewidth = 0.5) +
  geom_hline(yintercept = c(-limite, limite), linetype = "dashed", 
             color = qqq_pal$secondary, linewidth = 0.6) +
  annotate("rect", xmin = -Inf, xmax = Inf, ymin = -limite, ymax = limite,
           fill = qqq_pal$secondary, alpha = 0.08) +
  geom_segment(aes(xend = Lag, yend = 0), color = qqq_pal$primary, linewidth = 0.7) +
  geom_point(color = qqq_pal$primary, size = 1.5) +
  scale_x_continuous(breaks = seq(0, 28, 5)) +
  scale_y_continuous(limits = c(-0.15, 0.12)) +
  labs(title = "ACF - Serie Diferenciada",
       subtitle = "Identificación del orden q (MA)",
       x = "Rezago (Lag)",
       y = "ACF") +
  theme_QQQ() +
  theme(plot.title = element_text(size = 12))

p_pacf <- ggplot(df_pacf, aes(x = Lag, y = Valor)) +
  geom_hline(yintercept = 0, color = qqq_pal$text_gray, linewidth = 0.5) +
  geom_hline(yintercept = c(-limite, limite), linetype = "dashed", 
             color = qqq_pal$secondary, linewidth = 0.6) +
  annotate("rect", xmin = -Inf, xmax = Inf, ymin = -limite, ymax = limite,
           fill = qqq_pal$secondary, alpha = 0.08) +
  geom_segment(aes(xend = Lag, yend = 0), color = qqq_pal$primary, linewidth = 0.7) +
  geom_point(color = qqq_pal$primary, size = 1.5) +
  scale_x_continuous(breaks = seq(0, 28, 5)) +
  scale_y_continuous(limits = c(-0.15, 0.12)) +
  labs(title = "PACF - Serie Diferenciada",
       subtitle = "Identificación del orden p (AR)",
       x = "Rezago (Lag)",
       y = "PACF") +
  theme_QQQ() +
  theme(plot.title = element_text(size = 12))

grid.arrange(p_acf, p_pacf, ncol = 2)

4.3.2 Modelos ARIMA Candidatos

tabla_candidatos <- data.frame(
  Modelo = c("ARIMA(0,1,0)", 
             "ARIMA(1,1,1)",
             "ARIMA(2,1,1)", 
             "ARIMA(1,1,2)",
             "ARIMA(2,1,2)",
             "ARIMA(3,1,3)"),
  Tipo = c("Random Walk",
           "auto.arima()",
           "Manual",
           "Manual",
           "Manual",
           "Exploratorio"),
  `Observación ACF/PACF` = c(
    "Patrón general cercano a ruido blanco",
    "Selección automática por AICc",
    "Posible estructura en lags 1-2 del PACF",
    "Posible estructura en lags 1-2 del ACF",
    "Combinación de estructuras en ambos correlogramas",
    "Pico marginal en lag 3 de ambos correlogramas"
  ),
  Justificación = c(
    "Benchmark obligatorio: hipótesis de mercado eficiente",
    "Referencia algorítmica para validar selección manual",
    "Extensión AR(2) para capturar persistencia de corto plazo",
    "Extensión MA(2) para capturar estructura de media móvil",
    "Modelo simétrico que combina dinámicas AR y MA",
    "Evaluar si rezagos marginales aportan capacidad predictiva"
  )
)

kable(tabla_candidatos,
      caption = "Modelos ARIMA Candidatos para Evaluación",
      align = c("l", "c", "l", "l"),
      col.names = c("Modelo", "Tipo", "Observación en ACF/PACF", "Justificación")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(1, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(2, color = qqq_pal$secondary) %>%
  column_spec(3, width = "18em") %>%
  column_spec(4, width = "22em") %>%
  row_spec(2, background = "#e8f5e9", color = qqq_pal$text_dark, bold = TRUE)
Modelos ARIMA Candidatos para Evaluación
Modelo Tipo Observación en ACF/PACF Justificación
ARIMA(0,1,0) Random Walk Patrón general cercano a ruido blanco Benchmark obligatorio: hipótesis de mercado eficiente
ARIMA(1,1,1) auto.arima() Selección automática por AICc Referencia algorítmica para validar selección manual
ARIMA(2,1,1) Manual Posible estructura en lags 1-2 del PACF Extensión AR(2) para capturar persistencia de corto plazo
ARIMA(1,1,2) Manual Posible estructura en lags 1-2 del ACF Extensión MA(2) para capturar estructura de media móvil
ARIMA(2,1,2) Manual Combinación de estructuras en ambos correlogramas Modelo simétrico que combina dinámicas AR y MA
ARIMA(3,1,3) Exploratorio Pico marginal en lag 3 de ambos correlogramas Evaluar si rezagos marginales aportan capacidad predictiva

4.4 Estimación y Comparación de Modelos

4.4.1 Criterios de Información

ModeloQA <- auto.arima(Entrenamiento)
modeloQ1 <- Arima(Entrenamiento, order = c(3,1,3))
modeloQ2 <- Arima(Entrenamiento, order = c(0,1,0))
modeloQ3 <- Arima(Entrenamiento, order = c(2,1,1))
modeloQ4 <- Arima(Entrenamiento, order = c(1,1,2))
modeloQ5 <- Arima(Entrenamiento, order = c(2,1,2))
comparacion_IC <- data.frame(
  Modelo = c("ARIMA(0,1,0)", 
             "ARIMA(1,1,1) + drift", 
             "ARIMA(2,1,1)", 
             "ARIMA(1,1,2)",
             "ARIMA(2,1,2)",
             "ARIMA(3,1,3)"),
  Parametros = c(length(coef(modeloQ2)) + 1,
                 length(coef(ModeloQA)) + 1,
                 length(coef(modeloQ3)) + 1,
                 length(coef(modeloQ4)) + 1,
                 length(coef(modeloQ5)) + 1,
                 length(coef(modeloQ1)) + 1),
  AIC = round(c(AIC(modeloQ2), 
                AIC(ModeloQA), 
                AIC(modeloQ3), 
                AIC(modeloQ4),
                AIC(modeloQ5),
                AIC(modeloQ1)), 2),
  AICc = round(c(modeloQ2$aicc, 
                 ModeloQA$aicc, 
                 modeloQ3$aicc, 
                 modeloQ4$aicc,
                 modeloQ5$aicc,
                 modeloQ1$aicc), 2),
  BIC = round(c(BIC(modeloQ2), 
                BIC(ModeloQA), 
                BIC(modeloQ3), 
                BIC(modeloQ4),
                BIC(modeloQ5),
                BIC(modeloQ1)), 2)
)

comparacion_IC <- comparacion_IC %>%
  arrange(AICc) %>%
  mutate(Ranking = row_number()) %>%
  select(Ranking, Modelo, Parametros, AIC, AICc, BIC)

kable(comparacion_IC,
      caption = "Comparación de Modelos por Criterios de Información",
      align = c("c", "l", "c", "c", "c", "c"),
      col.names = c("Ranking", "Modelo", "# Parámetros", "AIC", "AICc", "BIC")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(2, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(5, bold = TRUE, color = qqq_pal$positive) %>%
  row_spec(1, bold = TRUE, background = "#e8f5e9", color = qqq_pal$text_dark) %>%
  footnote(general = "Ordenado por AICc (menor es mejor). AICc es el criterio preferido para muestras finitas.",
           general_title = "Nota: ")
Comparación de Modelos por Criterios de Información
Ranking Modelo # Parámetros AIC AICc BIC
1 ARIMA(1,1,1) + drift 4 4663.89 4663.94 4682.35
2 ARIMA(2,1,2) 5 4668.06 4668.14 4691.13
3 ARIMA(0,1,0) 1 4668.38 4668.39 4673.00
4 ARIMA(1,1,2) 4 4668.46 4668.52 4686.92
5 ARIMA(2,1,1) 4 4668.52 4668.58 4686.98
6 ARIMA(3,1,3) 7 4669.04 4669.19 4701.34
Nota:
Ordenado por AICc (menor es mejor). AICc es el criterio preferido para muestras finitas.

4.4.2 Métricas de Precisión en Entrenamiento

acc_QA <- accuracy(ModeloQA)
acc_Q1 <- accuracy(modeloQ1)
acc_Q2 <- accuracy(modeloQ2)
acc_Q3 <- accuracy(modeloQ3)
acc_Q4 <- accuracy(modeloQ4)
acc_Q5 <- accuracy(modeloQ5)

comparacion_accuracy <- data.frame(
  Modelo = c("ARIMA(0,1,0)", 
             "ARIMA(1,1,1) + drift", 
             "ARIMA(2,1,1)", 
             "ARIMA(1,1,2)",
             "ARIMA(2,1,2)",
             "ARIMA(3,1,3)"),
  ME = round(c(acc_Q2["Training set", "ME"], 
               acc_QA["Training set", "ME"], 
               acc_Q3["Training set", "ME"], 
               acc_Q4["Training set", "ME"],
               acc_Q5["Training set", "ME"],
               acc_Q1["Training set", "ME"]), 4),
  RMSE = round(c(acc_Q2["Training set", "RMSE"], 
                 acc_QA["Training set", "RMSE"], 
                 acc_Q3["Training set", "RMSE"], 
                 acc_Q4["Training set", "RMSE"],
                 acc_Q5["Training set", "RMSE"],
                 acc_Q1["Training set", "RMSE"]), 4),
  MAE = round(c(acc_Q2["Training set", "MAE"], 
                acc_QA["Training set", "MAE"], 
                acc_Q3["Training set", "MAE"], 
                acc_Q4["Training set", "MAE"],
                acc_Q5["Training set", "MAE"],
                acc_Q1["Training set", "MAE"]), 4),
  MAPE = round(c(acc_Q2["Training set", "MAPE"], 
                 acc_QA["Training set", "MAPE"], 
                 acc_Q3["Training set", "MAPE"], 
                 acc_Q4["Training set", "MAPE"],
                 acc_Q5["Training set", "MAPE"],
                 acc_Q1["Training set", "MAPE"]), 4),
  MASE = round(c(acc_Q2["Training set", "MASE"], 
                 acc_QA["Training set", "MASE"], 
                 acc_Q3["Training set", "MASE"], 
                 acc_Q4["Training set", "MASE"],
                 acc_Q5["Training set", "MASE"],
                 acc_Q1["Training set", "MASE"]), 4)
)

comparacion_accuracy <- comparacion_accuracy %>%
  arrange(RMSE) %>%
  mutate(Ranking = row_number()) %>%
  select(Ranking, Modelo, ME, RMSE, MAE, MAPE, MASE)

kable(comparacion_accuracy,
      caption = "Métricas de Precisión sobre Datos de Entrenamiento",
      align = c("c", "l", rep("c", 5))) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(2, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(4, bold = TRUE, color = qqq_pal$positive) %>%
  row_spec(1, background = "#e8f5e9", color = qqq_pal$text_dark, bold = TRUE) %>%
  footnote(general = "ME: Error Medio | RMSE: Raíz del Error Cuadrático Medio | MAE: Error Absoluto Medio | MAPE: Error Porcentual (%) | MASE: Error Escalado",
           general_title = "Métricas: ")
Métricas de Precisión sobre Datos de Entrenamiento
Ranking Modelo ME RMSE MAE MAPE MASE
1 ARIMA(3,1,3) 0.4939 5.4759 3.9216 0.9540 1.0074
2 ARIMA(1,1,1) + drift -0.0001 5.4792 3.8704 0.9445 0.9943
3 ARIMA(2,1,2) 0.4405 5.4867 3.8894 0.9449 0.9992
4 ARIMA(1,1,2) 0.4439 5.4960 3.9003 0.9500 1.0020
5 ARIMA(2,1,1) 0.4446 5.4962 3.9000 0.9499 1.0019
6 ARIMA(0,1,0) 0.4438 5.5179 3.8878 0.9444 0.9988
Métricas:
ME: Error Medio | RMSE: Raíz del Error Cuadrático Medio | MAE: Error Absoluto Medio | MAPE: Error Porcentual (%) | MASE: Error Escalado

4.5 Diagnóstico de Residuos

El modelo seleccionado debe tener residuos que se comporten como ruido blanco (media cero, varianza constante, sin autocorrelación).

4.5.1 Análisis Gráfico de Residuos

residuos <- residuals(ModeloQA)

df_residuos <- data.frame(
  Fecha = index(residuos),
  Residuo = as.numeric(residuos)
)


p1 <- ggplot(df_residuos, aes(x = Fecha, y = Residuo)) +
  geom_line(color = qqq_pal$secondary, linewidth = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", 
             color = qqq_pal$primary, linewidth = 0.7) +
  geom_hline(yintercept = c(-2*sd(df_residuos$Residuo), 2*sd(df_residuos$Residuo)), 
             linetype = "dotted", color = qqq_pal$negative, linewidth = 0.5) +
  scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
  labs(title = "Residuos del Modelo en el Tiempo",
       subtitle = "Verificación de media cero y varianza constante",
       x = NULL,
       y = "Residuo") +
  theme_QQQ() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

p1

acf_resid <- acf(residuos, lag.max = 25, plot = FALSE)
df_acf_resid <- data.frame(
  Lag = as.numeric(acf_resid$lag[-1]),
  ACF = as.numeric(acf_resid$acf[-1])
)

n_resid <- length(residuos)
limite_resid <- qnorm(0.975) / sqrt(n_resid)

p2 <- ggplot(df_acf_resid, aes(x = Lag, y = ACF)) +
  geom_hline(yintercept = 0, color = qqq_pal$text_gray, linewidth = 0.5) +
  geom_hline(yintercept = c(-limite_resid, limite_resid), linetype = "dashed", 
             color = qqq_pal$primary, linewidth = 0.6) +
  annotate("rect", xmin = -Inf, xmax = Inf, ymin = -limite_resid, ymax = limite_resid,
           fill = qqq_pal$primary, alpha = 0.1) +
  geom_segment(aes(xend = Lag, yend = 0), color = qqq_pal$secondary, linewidth = 0.7) +
  geom_point(color = qqq_pal$secondary, size = 1.5) +
  scale_x_continuous(breaks = seq(0, 25, 5)) +
  scale_y_continuous(limits = c(-0.15, 0.15)) +
  labs(title = "ACF de Residuos",
       subtitle = "Verificación de independencia",
       x = "Rezago (Lag)",
       y = "ACF") +
  theme_QQQ()
p2

p3 <- ggplot(df_residuos, aes(x = Residuo)) +
  geom_histogram(aes(y = after_stat(density)), 
                 bins = 35, fill = qqq_pal$primary, 
                 color = "white", alpha = 0.7) +
  geom_density(color = qqq_pal$secondary, linewidth = 1) +
  stat_function(fun = dnorm, 
                args = list(mean = mean(df_residuos$Residuo), 
                            sd = sd(df_residuos$Residuo)),
                color = qqq_pal$negative, linewidth = 1, linetype = "dashed") +
  labs(title = "Distribución de Residuos",
       subtitle = "Verificación de normalidad",
       x = "Residuo",
       y = "Densidad",
       caption = "Línea roja punteada: distribución normal teórica") +
  theme_QQQ()
p3

4.5.2 Q-Q Plot de Normalidad

residuos_std <- scale(residuals(ModeloQA))
df_qq <- data.frame(residuos = residuos_std)

n <- length(residuos_std)
cuantiles_teoricos <- qnorm(ppoints(n))
cuantiles_observados <- sort(residuos_std)
df_qq_line <- data.frame(x = cuantiles_teoricos, y = cuantiles_observados)

fit <- lm(y ~ x, data = df_qq_line)
df_qq_line$fitted <- predict(fit, df_qq_line)

df_qq_puntos <- data.frame(
  x = cuantiles_teoricos,
  y = cuantiles_observados,
  label = paste0(
    "Cuantil teórico: ", round(cuantiles_teoricos, 3), "<br>",
    "Residuo observado: ", round(cuantiles_observados, 3)
  )
)

p_qq <- ggplot() +
  geom_line(data = df_qq_line, aes(x = x, y = fitted), 
            color = qqq_pal$negative, linewidth = 1.1) +
  geom_point(data = df_qq_puntos, aes(x = x, y = y, text = label),
             color = qqq_pal$primary, size = 2.5, alpha = 0.75) +
  labs(
    title = "Q-Q Plot de Residuos Estandarizados",
    subtitle = "Verificación de normalidad del modelo | Línea roja = distribución normal teórica",
    x = "Cuantiles Teóricos (Distribución Normal Estándar)",
    y = "Cuantiles Observados (Residuos Estandarizados)",
    caption = "✓ Puntos alineados con la línea roja indican buenos residuos normales"
  ) +
  theme_QQQ() +
  theme(
    plot.title = element_text(size = 13, face = "bold", color = qqq_pal$primary),
    plot.subtitle = element_text(size = 11, color = qqq_pal$text_gray, margin = margin(b = 8)),
    plot.caption = element_text(size = 9, color = qqq_pal$secondary, face = "italic"),
    panel.background = element_rect(fill = "#f8f9fa", color = NA),
    plot.background = element_rect(fill = "white", color = NA),
    axis.line = element_line(color = qqq_pal$text_gray, linewidth = 0.5),
    panel.grid.major = element_line(color = "#e8eef5", linewidth = 0.3),
    panel.grid.minor = element_blank()
  )

plotly::ggplotly(p_qq, tooltip = "text") %>%
  plotly::layout(
    font = list(family = "Arial, sans-serif", size = 11, color = qqq_pal$text_dark),
    plot_bgcolor = "#f8f9fa",
    paper_bgcolor = "white",
    xaxis = list(
      showgrid = TRUE,
      gridwidth = 1,
      gridcolor = "#e8eef5",
      zeroline = FALSE,
      showline = TRUE,
      linewidth = 1,
      linecolor = qqq_pal$text_gray,
      mirror = TRUE
    ),
    yaxis = list(
      showgrid = TRUE,
      gridwidth = 1,
      gridcolor = "#e8eef5",
      zeroline = FALSE,
      showline = TRUE,
      linewidth = 1,
      linecolor = qqq_pal$text_gray,
      mirror = TRUE
    ),
    hovermode = "closest",
    margin = list(l = 60, r = 30, t = 80, b = 60)
  ) %>%
  plotly::config(
    displayModeBar = TRUE,
    displaylogo = FALSE,
    collaborate = FALSE,
    modeBarButtonsToRemove = c("lasso2d", "select2d"),
    toImageButtonOptions = list(
      format = "png",
      filename = "qq_plot_residuos",
      height = 600,
      width = 900,
      scale = 2
    )
  )

4.5.3 Test de Independencia (Ljung-Box)

lb_test <- Box.test(residuals(ModeloQA), lag = 10, type = "Ljung-Box")

tabla_ljung <- data.frame(
  Métrica = c("Estadístico Ljung-Box", 
              "Grados de Libertad", 
              "P-valor",
              "Conclusión"),
  Valor = c(
    round(lb_test$statistic, 4),
    lb_test$parameter,
    round(lb_test$p.value, 4),
    ifelse(lb_test$p.value > 0.05, 
           "Residuos son ruido blanco ✓", 
           "Posible autocorrelación residual")
  )
)

kable(tabla_ljung, 
      caption = "Test de Ljung-Box: Independencia de Residuos",
      align = c("l", "c")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  row_spec(4, bold = TRUE, 
           background = ifelse(lb_test$p.value > 0.05, "#e8f5e9", "#ffe8e0"),
           color = qqq_pal$text_dark)
Test de Ljung-Box: Independencia de Residuos
Métrica Valor
Estadístico Ljung-Box 10.1399
Grados de Libertad 10
P-valor 0.4283
Conclusión Residuos son ruido blanco ✓

4.6 Pronóstico y Evaluación

pronostico <- forecast(ModeloQA, h = 10, level = 95)

ultima_fecha <- as.Date(index(Entrenamiento)[length(Entrenamiento)])

fechas_pronostico <- c()
fecha_actual <- ultima_fecha
dias_agregados <- 0

while(dias_agregados < 10) {
  fecha_actual <- fecha_actual + 1
  if (!(weekdays(fecha_actual) %in% c("sábado", "domingo", "Saturday", "Sunday"))) {
    fechas_pronostico <- c(fechas_pronostico, fecha_actual)
    dias_agregados <- dias_agregados + 1
  }
}

fechas_pronostico <- as.Date(fechas_pronostico, origin = "1970-01-01")

4.6.1 Tabla de Pronósticos

tabla_pronostico <- data.frame(
  Día = 1:10,
  Fecha = as.character(fechas_pronostico),
  Pronóstico = round(as.numeric(pronostico$mean), 2),
  `Límite Inferior` = round(as.numeric(pronostico$lower), 2),
  `Límite Superior` = round(as.numeric(pronostico$upper), 2),
  `Amplitud IC` = round(as.numeric(pronostico$upper) - as.numeric(pronostico$lower), 2)
)

kable(tabla_pronostico,
      caption = "Pronósticos del Modelo ARIMA(1,1,1) con Drift - Intervalo de Confianza al 95%",
      align = c("c", "c", "c", "c", "c", "c"),
      col.names = c("Día", "Fecha", "Pronóstico (USD)", "Lím. Inferior", "Lím. Superior", "Amplitud IC")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(1, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(3, bold = TRUE, color = qqq_pal$primary, background = "#f0f9ff") %>%
  column_spec(4, color = qqq_pal$negative) %>%
  column_spec(5, color = qqq_pal$positive) %>%
  column_spec(6, color = "#666666") %>%
  footnote(general = "IC = Intervalo de Confianza. La amplitud del intervalo aumenta con el horizonte de pronóstico.",
           general_title = "Nota: ")
Pronósticos del Modelo ARIMA(1,1,1) con Drift - Intervalo de Confianza al 95%
Día Fecha Pronóstico (USD) Lím. Inferior Lím. Superior Amplitud IC
1 2025-10-01 600.71 589.94 611.47 21.54
2 2025-10-02 601.23 586.43 616.03 29.60
3 2025-10-03 601.61 583.40 619.83 36.42
4 2025-10-06 602.11 581.20 623.01 41.81
5 2025-10-07 602.51 579.11 625.92 46.82
6 2025-10-08 602.99 577.40 628.57 51.17
7 2025-10-09 603.41 575.76 631.06 55.30
8 2025-10-10 603.87 574.34 633.40 59.06
9 2025-10-13 604.30 572.98 635.63 62.65
10 2025-10-14 604.76 571.75 637.76 66.01
Nota:
IC = Intervalo de Confianza. La amplitud del intervalo aumenta con el horizonte de pronóstico.

4.6.2 Gráfico: Pronóstico con Intervalo de Confianza

n_historico <- 100
datos_hist <- tail(Entrenamiento, n_historico)

df_historico <- data.frame(
  Fecha = as.Date(index(datos_hist)),
  Precio = as.numeric(datos_hist),
  Tipo = "Histórico"
)

ultima_fecha <- as.Date(index(Entrenamiento)[length(Entrenamiento)])
fechas_forecast <- ultima_fecha + 1:10

df_pronostico <- data.frame(
  Fecha = fechas_forecast,
  Precio = as.numeric(pronostico$mean),
  Lower = as.numeric(pronostico$lower),
  Upper = as.numeric(pronostico$upper)
)

punto_conexion <- data.frame(
  Fecha = ultima_fecha,
  Precio = as.numeric(tail(datos_hist, 1)),
  Lower = as.numeric(tail(datos_hist, 1)),
  Upper = as.numeric(tail(datos_hist, 1))
)

df_pronostico_completo <- bind_rows(punto_conexion, df_pronostico)

ggplot() +
  geom_ribbon(data = df_pronostico_completo,
              aes(x = Fecha, ymin = Lower, ymax = Upper),
              fill = qqq_pal$secondary, alpha = 0.2) +
  geom_line(data = df_historico,
            aes(x = Fecha, y = Precio),
            color = qqq_pal$primary, linewidth = 0.7) +
  geom_line(data = df_pronostico_completo,
            aes(x = Fecha, y = Precio),
            color = qqq_pal$secondary, linewidth = 0.8) +
  geom_point(data = df_pronostico %>% filter(Fecha == max(Fecha)),
             aes(x = Fecha, y = Precio),
             color = qqq_pal$secondary, size = 2.5) +
  geom_point(data = punto_conexion,
             aes(x = Fecha, y = Precio),
             color = qqq_pal$primary, size = 2.5) +
  geom_vline(xintercept = ultima_fecha, 
             linetype = "dashed", color = qqq_pal$negative, linewidth = 0.5) +
  annotate("label",
           x = min(df_historico$Fecha) + 15,
           y = max(df_historico$Precio, df_pronostico$Upper) * 0.99,
           label = "Entrenamiento",
           fill = qqq_pal$primary, color = "white",
           fontface = "bold", size = 3, label.padding = unit(0.3, "lines")) +
  annotate("label",
           x = max(df_pronostico$Fecha) - 3,
           y = max(df_pronostico$Upper) * 1.01,
           label = "Pronóstico",
           fill = qqq_pal$secondary, color = "white",
           fontface = "bold", size = 3, label.padding = unit(0.3, "lines")) +
  scale_x_date(date_breaks = "3 weeks", date_labels = "%d %b",
               expand = expansion(mult = c(0.02, 0.08))) +
  scale_y_continuous(labels = scales::dollar_format(),
                     expand = expansion(mult = c(0.02, 0.05))) +
  labs(title = "Pronóstico ARIMA(1,1,1) con Drift",
       subtitle = "QQQ (Nasdaq-100 ETF) | Últimos 100 días + 10 días de pronóstico | IC 95%",
       x = NULL,
       y = "Precio de Cierre (USD)",
       caption = "Línea verde: Datos históricos | Línea cian: Pronóstico | Área sombreada: Intervalo de confianza 95%") +
  theme_QQQ() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

4.6.3 Evaluación Comparativa: Predicho vs Real

reales <- head(as.numeric(Prueba), 10)
predichos <- as.numeric(pronostico$mean)
fechas_prueba <- head(as.Date(index(Prueba)), 10)

df_evaluacion <- data.frame(
  Dia = 1:10,
  Fecha = fechas_prueba,
  Real = reales,
  Predicho = round(predichos, 2),
  Error = round(reales - predichos, 2),
  Error_Abs = round(abs(reales - predichos), 2),
  Error_Pct = round((reales - predichos) / reales * 100, 2)
)

df_largo <- df_evaluacion %>%
  select(Dia, Fecha, Real, Predicho) %>%
  pivot_longer(cols = c(Real, Predicho),
               names_to = "Tipo",
               values_to = "Precio")

ggplot(df_largo, aes(x = Dia, y = Precio, color = Tipo, shape = Tipo)) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 3) +
  geom_ribbon(data = df_evaluacion,
              aes(x = Dia, y = Predicho,
                  ymin = as.numeric(pronostico$lower),
                  ymax = as.numeric(pronostico$upper)),
              fill = qqq_pal$secondary, alpha = 0.15,
              inherit.aes = FALSE) +
  scale_color_manual(values = c("Real" = qqq_pal$primary, 
                                "Predicho" = qqq_pal$secondary),
                     labels = c("Predicho" = "Pronóstico", "Real" = "Valor Real")) +
  scale_shape_manual(values = c("Real" = 16, "Predicho" = 17),
                     labels = c("Predicho" = "Pronóstico", "Real" = "Valor Real")) +
  scale_x_continuous(breaks = 1:10, labels = paste0("t+", 1:10)) +
  scale_y_continuous(labels = scales::dollar_format()) +
  labs(title = "Evaluación del Pronóstico: Valores Reales vs Predichos",
       subtitle = "QQQ (Nasdaq-100 ETF) | Primeros 10 días del conjunto de prueba",
       x = "Horizonte de Pronóstico",
       y = "Precio de Cierre (USD)",
       color = NULL,
       shape = NULL,
       caption = "Área sombreada: Intervalo de confianza 95%") +
  theme_QQQ() +
  theme(legend.position = "top")

4.6.4 Tabla de Errores por Observación

tabla_errores <- df_evaluacion %>%
  select(Dia, Fecha, Real, Predicho, Error, Error_Pct) %>%
  mutate(
    Fecha = as.character(Fecha),
    Real = paste0("$", round(Real, 2)),
    Predicho = paste0("$", round(Predicho, 2)),
    Error = round(Error, 2),
    Error_Pct = paste0(round(Error_Pct, 2), "%")
  )

kable(tabla_errores,
      caption = "Evaluación del Pronóstico: Errores por Observación",
      align = c("c", "c", "c", "c", "c", "c"),
      col.names = c("Día", "Fecha", "Valor Real", "Pronóstico", "Error (USD)", "Error (%)")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(1, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(3, color = qqq_pal$primary, bold = TRUE) %>%
  column_spec(4, color = qqq_pal$secondary, bold = TRUE) %>%
  column_spec(5, bold = TRUE) %>%
  column_spec(6, bold = TRUE) %>%
  footnote(general = "Error positivo: el modelo subestimó (valor real > pronóstico). Error negativo: el modelo sobreestimó.",
           general_title = "Nota: ")
Evaluación del Pronóstico: Errores por Observación
Día Fecha Valor Real Pronóstico Error (USD) Error (%)
1 2025-10-01 $603.25 $600.71 2.54 0.42%
2 2025-10-02 $605.73 $601.23 4.50 0.74%
3 2025-10-03 $603.18 $601.61 1.57 0.26%
4 2025-10-06 $607.71 $602.11 5.60 0.92%
5 2025-10-07 $604.51 $602.51 2.00 0.33%
6 2025-10-08 $611.44 $602.99 8.45 1.38%
7 2025-10-09 $610.7 $603.41 7.29 1.19%
8 2025-10-10 $589.5 $603.87 -14.37 -2.44%
9 2025-10-13 $602.01 $604.3 -2.29 -0.38%
10 2025-10-14 $598 $604.76 -6.76 -1.13%
Nota:
Error positivo: el modelo subestimó (valor real > pronóstico). Error negativo: el modelo sobreestimó.

4.6.5 Métricas Finales de Evaluación

MAE <- mean(abs(df_evaluacion$Error))
RMSE <- sqrt(mean(df_evaluacion$Error^2))
MAPE <- mean(abs(df_evaluacion$Error_Pct))
ME <- mean(df_evaluacion$Error)

dentro_IC <- sum(reales >= as.numeric(pronostico$lower) & 
                   reales <= as.numeric(pronostico$upper))
pct_dentro_IC <- dentro_IC / 10 * 100

tabla_metricas <- data.frame(
  Métrica = c("Error Medio (ME)",
              "Error Absoluto Medio (MAE)",
              "Raíz del Error Cuadrático Medio (RMSE)",
              "Error Porcentual Absoluto Medio (MAPE)",
              "Observaciones dentro del IC 95%"),
  Valor = c(paste0("$", round(ME, 2)),
            paste0("$", round(MAE, 2)),
            paste0("$", round(RMSE, 2)),
            paste0(round(MAPE, 2), "%"),
            paste0(dentro_IC, " de 10 (", pct_dentro_IC, "%)")),
  Interpretación = c(
    ifelse(abs(ME) < 1, "Sin sesgo sistemático ✓", 
           ifelse(ME > 0, "Modelo subestima", "Modelo sobreestima")),
    "Error promedio en USD",
    "Penaliza errores grandes",
    "Error relativo al precio",
    ifelse(pct_dentro_IC >= 80, "Intervalos bien calibrados ✓", 
           "Intervalos pueden estar mal calibrados")
  )
)

kable(tabla_metricas,
      caption = "Métricas de Evaluación del Pronóstico - Datos de Prueba",
      align = c("l", "c", "l")) %>%
  kable_styling(bootstrap_options = c("hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, background = qqq_pal$primary, color = "white", bold = TRUE) %>%
  column_spec(1, bold = TRUE, color = qqq_pal$primary) %>%
  column_spec(2, bold = TRUE) %>%
  row_spec(5, background = "#e8f5e9", color = qqq_pal$text_dark, bold = TRUE)
Métricas de Evaluación del Pronóstico - Datos de Prueba
Métrica Valor Interpretación
Error Medio (ME) $0.85 Sin sesgo sistemático ✓
Error Absoluto Medio (MAE) $5.54 Error promedio en USD
Raíz del Error Cuadrático Medio (RMSE) $6.68 Penaliza errores grandes
Error Porcentual Absoluto Medio (MAPE) 0.92% Error relativo al precio
Observaciones dentro del IC 95% 10 de 10 (100%) Intervalos bien calibrados ✓

## 4.7 Síntesis del Modelo Seleccionado

9. Conclusiones

9.1 Hallazgos Principales

[PLACEHOLDER: Resumen de hallazgos principales del análisis ARIMA]

9.2 Implicaciones Prácticas

[PLACEHOLDER: Implicaciones de los pronósticos para inversionistas y analistas de mercado]

9.3 Limitaciones del Análisis

[PLACEHOLDER: Limitaciones del modelo y aspectos no capturados]

9.4 Recomendaciones Futuras

[PLACEHOLDER: Sugerencias para mejoras y extensiones del análisis]


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
ASIGNATURA: Gestión de Datos
PROFESOR: Orlando Joaqui-Barandica
UNIVERSIDAD: Universidad del Valle
FACULTAD: Facultad de Ingeniería
PROGRAMA: Ingeniería Industrial
ESTUDIANTE: Camilo
FECHA ENTREGA:
VERSIÓN: 1.0
Documento generado con R Markdown | Tema: Series de Tiempo y Pronósticos ARIMA
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━